(**********************************************************************

    :Program.    Clusters.def
    :Contents.   block orientated memory management
    :Author.     Nicolas Benezan [bne]
    :Address.    Postwiesenstr. 2, D7000 Stuttgart 60
    :Phone.      711/333679
    :Copyright.  Public Domain
    :Language.   Modula-2
    :Translator. M2Amiga A+L V3.2d
    :Imports.    BigSets, TaskMemory [bne]
    :History.    V1.0 [bne] 02.Jul.1989
    :History.    V1.1 [bne] 09.Jul.1989 (TYPEs optimized, bugs fixed)

**********************************************************************)

DEFINITION MODULE Clusters;

FROM BigSets    IMPORT BigSet;
FROM SYSTEM     IMPORT ADDRESS;

TYPE
  HeapPtr=POINTER TO Heap;
  ClusterPtr=POINTER TO Cluster;
  Heap=RECORD
    clusterList: ClusterPtr;     (* sorted list, ascending address order *)
    firstFreeCluster: ClusterPtr;(* Cluster with >=1 free blocks | NIL   *)
    clusterSize: LONGINT;        (* total size of MemChunks for Clusters *)
    blockSize: LONGINT;          (* size of blocks + 4 bytes overhead    *)
    blocksPerCluster: CARDINAL;  (* maximum blocks per Cluster           *)
  END;
  Cluster=RECORD
    next, pred: ClusterPtr;      (* pointers for double linked list      *)
    heap: HeapPtr;               (* backward pointer to root of list     *)
    blockAllocMap: BigSet;       (* bit set=block allocated, clear=free  *)
    freeBlocks: CARDINAL;        (* number of remaining free blocks      *)
    firstFreeBlock: CARDINAL;    (* undefined if freeBlocks=0            *)
  (*data: ARRAY [0..blocksPerCluster-1],[0..blockSize+3] OF BYTE;        *)
  END;
  (* The following conditions must hold true before and after every      *)
  (* access to a heap/cluster list:                                      *)
  (* - Cluster.next is NIL or points to a Cluster at a higher address.   *)
  (* - Cluster.pred points to a Cluster at a lower address or to         *)
  (*   Heap.clusterList.                                                 *)
  (* - firstFreeCluster points to the Cluster which has >=1 free blocks  *)
  (*   at the lowest address.                                            *)
  (* - There must never be a cluster which has all blocks free.          *)
  (* - freeBlocks is equal to the number of free blocks in this Cluster. *)
  (* - firstFreeBlock is the number of the free block at the lowest      *)
  (*   address in this Cluster. If freeBlocks=0 then firstFreeBlock is   *)
  (*   undefined.                                                        *)
  (* - Each block of a Cluster has a coresponding bit in blockAllocMap.  *)
  (*   A clear bit means block is free, a set one means block allocated. *)

  AllocationProc=PROCEDURE(VAR ADDRESS, LONGINT);
  DeallocationProc=PROCEDURE(VAR ADDRESS);

VAR
  HeapArray: HeapPtr; (* POINTER TO ARRAY [0..NumHeaps-1] OF Heap *)
  NumHeaps: CARDINAL;

PROCEDURE InitMemManager(Allocation: AllocationProc;
                         Deallocation: DeallocationProc;
                         ClusterSize: LONGINT;
                         BlockSizes: ARRAY OF LONGINT): BOOLEAN;

(*:Semantic. Startup procedure, must be called before any other operation.
  :Input.    Allocation: procedure for global memory allocation
  :Input.                (e.g. MemSystem.Allocate)
  :Input.    Deallocation: procedure for global memory deallocation
  :Input.                (e.g. MemSystem.Deallocate)
  :Input.    ClusterSize: size of the blocks allocated from the global pool
  :Input.    BlockSizes: array of the sizes of blocks which should be
  :Input.                allocated by Allocate() in an optimized way
  :Note.                 (the most time critical first... )
  :Result.   TRUE = o.k., FALSE = startup failed
*)

PROCEDURE Allocate(VAR Pointer: ADDRESS;
                       Size: LONGINT);

(*:Semantic. Replaces the usual memory allocation procedures now. If a Size
  :Semantic. is requested which is included in the BlockSizes array, the
  :Semantic. allocation is handled with the help of cluster structures.
  :Semantic. Otherwise a single block of memory is allocated.
  :Semantic. If you allocate/deallocate a lot of small blocks of memory,
  :Semantic. Clusters will improve performance and your free memory won't
  :Semantic. be as scattered and hashed as it would be using AllocMem() or
  :Semantic. similar procedures.
*)

PROCEDURE Deallocate(VAR Pointer: ADDRESS);

(*:Semantic. Deallocates memory allocated by Allocate().
*)

PROCEDURE FindBlock(    Block: ADDRESS;
                    VAR ClPtr: ClusterPtr): CARDINAL;

(*:Semantic. Finds the Cluster to which the block belongs and returns the
  :Semantic. number of the block within that cluster.
  :Note.     for advanced aplications only (e.g. garbage collection)
*)

END Clusters.

